home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Resource V24148852001.psc / mMain.bas < prev    next >
Encoding:
BASIC Source File  |  2001-07-19  |  5.4 KB  |  161 lines
  1. Attribute VB_Name = "mMain"
  2.  
  3. Public Enum ResTypes
  4.    RT_CURSOR = 1&
  5.    RT_BITMAP = 2&
  6.    RT_ICON = 3&
  7.    RT_MENU = 4&
  8.    RT_DIALOG = 5&
  9.    RT_STRING = 6&
  10.    RT_FONTDIR = 7&
  11.    RT_FONT = 8&
  12.    RT_ACCELERATOR = 9&
  13.    RT_RCDATA = 10&
  14.    RT_MESSAGETABLE = 11&
  15.    RT_GROUP_CURSOR = 12&
  16.    RT_GROUP_ICON = 14&
  17.    RT_VERSION = 16&
  18.    RT_DLGINCLUDE = 17&
  19.    RT_PLUGPLAY = 19&
  20.    RT_VXD = 20&
  21.    RT_ANICURSOR = 21&
  22.    RT_ANIICON = 22&
  23.    RT_HTML = 23&
  24. End Enum
  25.  
  26. Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  27. Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  28. Public Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
  29. Private Const DONT_RESOLVE_DLL_REFERENCES = &H1
  30. Public Const LOAD_LIBRARY_AS_DATAFILE = 2
  31.  
  32. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  33. Private Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
  34. Public Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
  35. Public Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
  36.  
  37. Public hModule As Long
  38. Public picHeight As Long, picWidth As Long
  39.  
  40. Public Function InitResource(ByVal sLibName As String) As Boolean
  41.   On Error Resume Next
  42.   hModule = LoadLibraryEx(sLibName, 0, 1)
  43. '  hModule = LoadLibrary(sLibName)
  44.   InitResource = (hModule <> 0)
  45. End Function
  46.  
  47. Public Sub ClearResource()
  48.    If Dir(TEMP_FILE_NAME) <> "" Then
  49.       Call mciSendString("close video", 0&, 0, 0)
  50.       Kill TEMP_FILE_NAME
  51.    End If
  52.    If hDialog Then Call DestroyWindow(hDialog)
  53.    If hModule Then FreeLibrary (hModule)
  54. End Sub
  55.  
  56. Public Function ResTypeName(ByVal ResType As ResTypes) As String
  57.    Select Case ResType
  58.       Case RT_ACCELERATOR
  59.          ResTypeName = "Accelerator table"
  60.       Case RT_ANICURSOR
  61.          ResTypeName = "Animated cursor"
  62.       Case RT_ANIICON
  63.          ResTypeName = "Animated icon"
  64.       Case RT_BITMAP
  65.          ResTypeName = "Bitmap resource"
  66.       Case RT_CURSOR
  67.          ResTypeName = "Hardware-dependent cursor resource"
  68.       Case RT_DIALOG
  69.          ResTypeName = "Dialog box"
  70.       Case RT_DLGINCLUDE
  71.          ResTypeName = "Header file that contains menu and dialog box #define statements"
  72.       Case RT_FONT
  73.          ResTypeName = "Font resource"
  74.       Case RT_FONTDIR
  75.          ResTypeName = "Font directory resource"
  76.       Case RT_GROUP_CURSOR
  77.          ResTypeName = "Hardware-independent cursor resource"
  78.       Case RT_GROUP_ICON
  79.          ResTypeName = "Hardware-independent icon resource"
  80.       Case RT_HTML
  81.          ResTypeName = "HTML document"
  82.       Case RT_ICON
  83.          ResTypeName = "Hardware-dependent icon resource"
  84.       Case RT_MENU
  85.          ResTypeName = "Menu resource"
  86.       Case RT_MESSAGETABLE
  87.          ResTypeName = "Message-table entry"
  88.       Case RT_PLUGPLAY
  89.          ResTypeName = "Plug and play resource"
  90.       Case RT_RCDATA
  91.          ResTypeName = "Application-defined resource (raw data)"
  92.       Case RT_STRING
  93.          ResTypeName = "String-table entry"
  94.       Case RT_VERSION
  95.          ResTypeName = "Version resource"
  96.       Case RT_VXD
  97.          ResTypeName = "VXD"
  98.       Case Else
  99.          ResTypeName = "User-defined custom resource"
  100.    End Select
  101. End Function
  102.  
  103. Public Function StrFromPtrA(ByVal lpszA As Long, Optional nSize As Long = 0) As String
  104.    Dim s As String, bTrim As Boolean
  105.    If nSize = 0 Then
  106.       nSize = lstrlenA(lpszA)
  107.       bTrim = True
  108.    End If
  109.    s = String(nSize, Chr$(0))
  110.    CopyStringA s, ByVal lpszA
  111.    If bTrim Then s = TrimNULL(s)
  112.    StrFromPtrA = s
  113. End Function
  114.  
  115. Public Function StrFromPtrW(ByVal lpszW As Long, Optional nSize As Long = 0) As String
  116.    Dim s As String, bTrim As Boolean
  117.    If nSize = 0 Then
  118.       nSize = lstrlenW(lpszW)
  119.       bTrim = True
  120.    End If
  121.    s = String(nSize, Chr$(0))
  122.    CopyMemory ByVal StrPtr(s), ByVal lpszW, nSize
  123.    If bTrim Then s = TrimNULL(s)
  124.    StrFromPtrW = s
  125. End Function
  126.  
  127. Public Function TrimNULL(ByVal str As String) As String
  128.     If InStr(str, Chr$(0)) > 0& Then
  129.         TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
  130.     Else
  131.         TrimNULL = str
  132.     End If
  133. End Function
  134.  
  135. Public Function MakeLangID(ByVal usPrimaryLanguage As Integer, ByVal usSubLanguage As Long) As Long
  136.     MakeLangID = usSubLanguage * 2 ^ 10 + usPrimaryLanguage
  137. End Function
  138.  
  139. Public Function ReplaceStr(ByVal str As String, ByVal sReplace As String, Optional ByVal sReplaceWith As String, Optional fCompare As VbCompareMethod) As String
  140.     Dim iLenOut As Integer, iLenIn As Integer
  141.     Dim i As Long
  142.     iLenOut = Len(sReplace)
  143.     iLenIn = Len(sReplaceWith)
  144.     If Len(str) > 0& Then
  145.         If iLenOut > 0& Then
  146.             Dim sOut As String
  147.             i = InStr(1&, str, sReplace, fCompare)
  148.             Do Until i = 0&
  149.                 If iLenIn > 0& Then
  150.                     str = Left$(str, i - 1&) & sReplaceWith & Mid$(str, i + iLenOut)
  151.                 Else
  152.                     str = Left$(str, i - 1&) & Mid$(str, i + iLenOut)
  153.                 End If
  154.                 i = InStr(i + iLenIn, str, sReplace, fCompare)
  155.             Loop
  156.         End If
  157.     End If
  158.     ReplaceStr = str
  159. End Function
  160.  
  161.